home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2posx10.zoo / m2posix.10 / src / dossuppo.ipp < prev    next >
Encoding:
Modula Implementation  |  1993-12-23  |  19.9 KB  |  742 lines

  1. IMPLEMENTATION MODULE DosSupport;
  2. __IMP_SWITCHES__
  3. #ifdef HM2
  4. #ifdef __LONG_WHOLE__
  5. (*$!i+: Modul muss mit $i- uebersetzt werden! *)
  6. (*$!w+: Modul muss mit $w- uebersetzt werden! *)
  7. #else
  8. (*$!i-: Modul muss mit $i+ uebersetzt werden! *)
  9. (*$!w-: Modul muss mit $w+ uebersetzt werden! *)
  10. #endif
  11. #endif
  12. (*****************************************************************************)
  13. (* "UnixToDos()" basiert auf der MiNTLIB von Eric R. Smith und anderen       *)
  14. (* --------------------------------------------------------------------------*)
  15. (* 05-Dez-93, Holger Kleinschmidt                                            *)
  16. (*****************************************************************************)
  17.  
  18. VAL_INTRINSIC
  19. CAST_IMPORT
  20.  
  21. FROM SYSTEM IMPORT
  22. (* TYPE *) ADDRESS,
  23. (* PROC *) ADR;
  24.  
  25. FROM PORTAB IMPORT
  26. (* CONST*) NULL,
  27. (* TYPE *) SIGNEDWORD, SIGNEDLONG, UNSIGNEDWORD, WORDSET;
  28.  
  29. FROM OSCALLS IMPORT
  30. (* PROC *) Dgetdrv, Dgetcwd, Dgetpath, Fgetdta, Fsetdta, Fsfirst, Fsnext,
  31.            Fseek, Fforce;
  32.  
  33. FROM MEMBLK IMPORT
  34. (* PROC *) memalloc, memdealloc;
  35.  
  36. FROM ctype IMPORT
  37. (* PROC *) tolower, toupper, isalpha, todigit, tocard;
  38.  
  39. FROM cstr IMPORT
  40. (* PROC *) AssignCToM2, AssignM2ToC, strrchr, strcmp, strncmp, strncpy;
  41.  
  42. FROM pSTRING IMPORT
  43. (* PROC *) COPY, ASSIGN, APPEND, DELETE, EQUAL, EQUALN, UPPER, TOKEN,
  44.            RPOSCHR;
  45.  
  46. FROM types IMPORT
  47. (* CONST*) EOS, PATHMAX, DDIRSEP, XDIRSEP, DDRVPOSTFIX, XDEVPREFIX, SUFFIXSEP,
  48. (* TYPE *) sizeT, ExtName, PathName, StrPtr, StrRange;
  49.  
  50. IMPORT e;
  51.  
  52. FROM cmdline IMPORT
  53. (* PROC *) getenv, GetEnvVar;
  54.  
  55. FROM DosSystem IMPORT
  56. (* PROC *) MiNTVersion;
  57.  
  58. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  59.  
  60. CONST
  61.   EOKL    = LIC(0);
  62. #if no_MIN_MAX
  63.   MAXCARD = CAST(CARDINAL,-1);
  64. #else
  65.   MAXCARD = MAX(CARDINAL);
  66. #endif
  67.  
  68. VAR
  69.   MiNT : CARDINAL;
  70.  
  71. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  72.  
  73. PROCEDURE isexec (    path    : StrPtr;
  74.                   REF default : ARRAY OF CHAR;
  75.                   REF var     : ARRAY OF CHAR ): BOOLEAN;
  76.  
  77. VAR  sAdr,dAdr : StrPtr;
  78.      l1, l2    : CARDINAL;
  79.      hasExt    : BOOLEAN;
  80.      tIdx      : CARDINAL;
  81.      ext       : ExtName;
  82.      token     : ExtName;
  83.      suffices  : PathName;
  84.  
  85. BEGIN
  86.  sAdr := strrchr(path, SUFFIXSEP);
  87.  dAdr := strrchr(path, DDIRSEP);
  88.  
  89.  IF DIFADR(sAdr, dAdr) <= VAL(SIGNEDLONG,0) THEN
  90.    RETURN(FALSE);
  91.  ELSE
  92.    AssignCToM2(ADDADR(sAdr, 1), ext);
  93.  END;
  94.  
  95.  IF NOT GetEnvVar(var, suffices) THEN
  96.    ASSIGN(default, suffices);
  97.  END;
  98.  
  99.  (* moeglicherweise ist die Nichtunterscheidung von Klein/Grossbuchstaben
  100.   * falsch, keine Ahnung...
  101.   *)
  102.  UPPER(suffices);
  103.  UPPER(ext);
  104.  
  105.  tIdx := 0; l1 := 0;
  106.  WHILE TOKEN(suffices, ";,", tIdx, l1, l2, token) DO
  107.    IF EQUAL(ext, token) THEN
  108.      RETURN(TRUE);
  109.    END;
  110.  END;
  111.  RETURN(FALSE);
  112. END isexec;
  113.  
  114. (*---------------------------------------------------------------------------*)
  115.  
  116. PROCEDURE IsExec ((* EIN/ -- *) path : StrPtr ): BOOLEAN;
  117. BEGIN
  118.  RETURN(isexec(path, EXECSUFFIX, "SUFFIX"));
  119. END IsExec;
  120.  
  121. (*---------------------------------------------------------------------------*)
  122.  
  123. PROCEDURE IsGEMExec ((* EIN/ -- *) path : StrPtr ): BOOLEAN;
  124. BEGIN
  125.  RETURN(isexec(path, GEMEXT, "GEMEXT"));
  126. END IsGEMExec;
  127.  
  128. (*---------------------------------------------------------------------------*)
  129.  
  130. PROCEDURE IsDosExec ((* EIN/ -- *) path : StrPtr ): BOOLEAN;
  131. BEGIN
  132. #if (defined __GEMDOS__)
  133.  RETURN(isexec(path, TOSEXT, "TOSEXT"));
  134. #else
  135.  RETURN(isexec(path, DOSEXT, "DOSEXT"));
  136. #endif
  137. END IsDosExec;
  138.  
  139. (*---------------------------------------------------------------------------*)
  140.  
  141. PROCEDURE prefixLen ((* EIN/ -- *) path : StrPtr ): UNSIGNEDWORD;
  142.  
  143. VAR __REG__ i : UNSIGNEDWORD;
  144.     __REG__ c : CHAR;
  145.     __REG__ p : StrPtr;
  146.  
  147. BEGIN
  148.  i := 0;
  149.  p := path;
  150.  REPEAT
  151.    c := p^[i];
  152.    INC(i);
  153.  UNTIL (c = 0C) OR (c = DDIRSEP) OR (c = XDIRSEP) OR (c = DDRVPOSTFIX);
  154.  IF c = DDRVPOSTFIX THEN
  155.    RETURN(i);
  156.  ELSE
  157.    RETURN(0);
  158.  END;
  159. END prefixLen;
  160.  
  161. (*---------------------------------------------------------------------------*)
  162.  
  163. PROCEDURE IsDosDevice ((* EIN/ -- *) path : StrPtr ): BOOLEAN;
  164.  
  165. VAR __REG__ i : UNSIGNEDWORD;
  166.  
  167. BEGIN
  168.  i := prefixLen(path);
  169.  RETURN((i > 2) AND (path^[i] = 0C));
  170. END IsDosDevice;
  171.  
  172. (*---------------------------------------------------------------------------*)
  173.  
  174. PROCEDURE CompletePath ((* EIN/ -- *)     path  : StrPtr;
  175.                         (* EIN/ -- *)     fSize : StrRange;
  176.                         (* -- /AUS *)     full  : StrPtr;
  177.                         (* -- /AUS *) VAR fLen  : INTEGER;
  178.                         (* -- /AUS *) VAR err   : INTEGER   ): BOOLEAN;
  179.  
  180. VAR __REG__ drv  : CARDINAL;
  181.     __REG__ pIdx : UNSIGNEDWORD;
  182.     __REG__ fIdx : UNSIGNEDWORD;
  183.     __REG__ f    : StrPtr;
  184.     __REG__ p    : StrPtr;
  185.  
  186. BEGIN
  187.  f := full;
  188.  p := path;
  189.  IF fSize < 4 THEN
  190.    (* weniger als drei Zeichen + Nullbyte Platz *)
  191.    err := e.eRANGE;
  192.    RETURN(FALSE);
  193.  END;
  194.  IF (p^[0] = 0C) OR (p^[1] <> DDRVPOSTFIX) THEN
  195.    (* Wenn kein Laufwerk angegeben ist, aktuelles Laufwerk ermitteln *)
  196.    drv   := Dgetdrv();
  197.    f^[0] := todigit(drv + 10);
  198.    pIdx  := 0;
  199.    INC(drv); (* fuer "Dgetpath" *)
  200.  ELSE
  201.    (* sonst angegebenes Laufwerk uebernehmen *)
  202.    f^[0] := p^[0];
  203.    pIdx  := 2;
  204.    drv   := tocard(p^[0]) - 9; (* - 10 + 1 *)
  205.  END;
  206.  f^[1] := DDRVPOSTFIX;
  207.  
  208.  fIdx := 2;
  209.  err  := 0;
  210.  IF p^[pIdx] <> DDIRSEP THEN
  211.    (* relativer Pfad angegeben -> aktuellen Pfad ermitteln *)
  212.    IF MiNT >= 96 THEN
  213.      IF NOT Dgetcwd(ADDADR(f, 2), drv, fSize - 2, err) THEN
  214.        RETURN(FALSE);
  215.      END;
  216.    ELSIF NOT Dgetpath(ADDADR(f, 2), drv, err) THEN
  217.      RETURN(FALSE);
  218.    END;
  219.  
  220.    WHILE f^[fIdx] <> 0C DO
  221.      INC(fIdx);
  222.    END;
  223.    IF fIdx >= fSize THEN
  224.      (* Ist wahrscheinlich schon zu spaet, da ueber <full> hinaus
  225.       * geschrieben wurde, aber schaden kanns auch nicht.
  226.       * (Kann nur auftreten, wenn 'Dgetpath' benutzt wurde)
  227.       *)
  228.      err := e.eRANGE;
  229.      RETURN(FALSE);
  230.    ELSE
  231.      IF (fIdx = 2) OR (p^[pIdx] <> 0C) THEN
  232.        (* Ein Wurzelverzeichnis muss mit einem Backslash gekennzeichnet
  233.         * werden. Wenn ein (relativer) Pfad angegeben war, muss ebenfalls
  234.         * ein Backslash zur Trennung eingefuegt werden.
  235.         *)
  236.        f^[fIdx] := DDIRSEP;
  237.        INC(fIdx);
  238.      END;
  239.    END;
  240.  END;
  241.  
  242.  WHILE (p^[pIdx] <> 0C) AND (fIdx < fSize) DO
  243.    f^[fIdx] := p^[pIdx];
  244.    INC(fIdx);
  245.    INC(pIdx);
  246.  END;
  247.  
  248.  IF fIdx >= fSize THEN
  249.    err := e.eRANGE;
  250.    RETURN(FALSE);
  251.  ELSE
  252.    f^[fIdx] := 0C;
  253.    fLen     := INT(fIdx);
  254.    RETURN(TRUE);
  255.  END;
  256. END CompletePath;
  257.  
  258. (*---------------------------------------------------------------------------*)
  259.  
  260. PROCEDURE DosToUnix ((* EIN/AUS *)     dpath : StrPtr;
  261.                      (* EIN/ -- *)     xSize : StrRange;
  262.                      (* -- /AUS *)     xpath : StrPtr;
  263.                      (* -- /AUS *) VAR dlen  : INTEGER;
  264.                      (* -- /AUS *) VAR xlen  : INTEGER  );
  265.  
  266. VAR __REG__ dIdx   : UNSIGNEDWORD;
  267.     __REG__ dLen   : UNSIGNEDWORD;
  268.     __REG__ c      : CHAR;
  269.     __REG__ drv    : CHAR;
  270.     __REG__ d      : StrPtr;
  271.     __REG__ x      : StrPtr;
  272.             pre    : UNSIGNEDWORD;
  273.             pipe   : BOOLEAN;
  274.             device : BOOLEAN;
  275.             tmp    : ARRAY [0..14] OF CHAR;
  276.             tmpLen : UNSIGNEDWORD;
  277.  
  278. BEGIN
  279.  d    := dpath;
  280.  x    := xpath;
  281.  dIdx := 0;
  282.  WHILE d^[dIdx] <> 0C DO
  283.    (*  \ --> /  und gegebenenfalls in Kleinbuchstaben wandeln *)
  284.    c := d^[dIdx];
  285.    IF c = DDIRSEP THEN
  286.      c := XDIRSEP;
  287.    ELSIF MiNT = 0 THEN
  288.      c := tolower(c);
  289.    END;
  290.    d^[dIdx] := c;
  291.    INC(dIdx);
  292.  END;
  293.  
  294.  dLen := dIdx;
  295.  dlen := VAL(INTEGER,dIdx);
  296.  pre  := prefixLen(d);
  297.  drv  := tolower(d^[0]);
  298.  
  299.  IF pre = 2 THEN
  300.    (* Laufwerk, "x:" *)
  301.    pipe   := FALSE;
  302.    device := FALSE;
  303.    dIdx   := 2;
  304.    IF MiNT > 0 THEN
  305.      IF drv = 'q' THEN
  306.        (* <xpath>^ wird 3 Zeichen laenger als <dpath>^, wenn ein absoluter
  307.         * Pfad angegeben ist, sonst 4 Zeichen.
  308.         *)
  309.        pipe := TRUE;
  310.      ELSIF drv = 'v' THEN
  311.        (* <xpath>^ wird 2 Zeichen laenger als <dpath>^, wenn ein absoluter
  312.         * Pfad angegeben ist, sonst 3 Zeichen.
  313.         *)
  314.        device := TRUE;
  315.      ELSIF drv = 'u' THEN
  316.        c     := d^[0];
  317.        d^[0] := drv;
  318.        tmp   := "u:/pipeu:/dev";
  319.        IF strncmp(CAST(StrPtr,ADR(tmp)), d, 7) = 0 THEN
  320.          pipe := (dLen = 7) OR (d^[7] = XDIRSEP);
  321.          IF pipe THEN
  322.            (* <xpath>^ wird 2 Zeichen kuerzer als <dpath>^, wenn ein absoluter
  323.             * Pfad angegeben ist, sonst 1 Zeichen.
  324.             *)
  325.            dIdx := 7;
  326.          END;
  327.        ELSIF strncmp(CAST(StrPtr,ADR(tmp[7])), d, 6) = 0 THEN
  328.          device := (dLen = 6) OR (d^[6] = XDIRSEP);
  329.          IF device THEN
  330.            (* <xpath>^ wird 2 Zeichen kuerzer als <dpath>^, wenn ein absoluter
  331.             * Pfad angegeben ist, sonst 1 Zeichen.
  332.             *)
  333.            dIdx := 6;
  334.          END;
  335.        ELSIF (dLen >= 4) AND (d^[2] = XDIRSEP)
  336.          AND ((dLen = 4) OR (d^[4] = XDIRSEP))
  337.        THEN
  338.          (* "u:/x" oder "u:/x/..." *)
  339.          drv  := tolower(d^[3]);
  340.          dIdx := 4;
  341.        END;
  342.        d^[0] := c;
  343.      END;
  344.    END; (* IF MiNT *)
  345.  
  346.    IF pipe THEN
  347.      tmp    := "/pipe";
  348.      tmpLen := 5;
  349.    ELSIF device THEN
  350.      tmp    := "/dev";
  351.      tmpLen := 4;
  352.    ELSE
  353.      IF ROOTDIR = drv THEN
  354.        IF dLen = dIdx THEN
  355.          tmp    := "/";
  356.          tmpLen := 1;
  357.        ELSE
  358.          tmp    := "";
  359.          tmpLen := 0;
  360.        END;
  361.      ELSIF ROOTDIR = 'u' THEN
  362.        tmp    := "/@";
  363.        tmp[1] := drv;
  364.        tmpLen := 2;
  365.      ELSE
  366.        tmp    := "/dev/@";
  367.        tmp[5] := drv;
  368.        tmpLen := 6;
  369.      END;
  370.    END; (* IF pipe *)
  371.    IF (dIdx < dLen) AND (d^[dIdx] <> XDIRSEP) THEN
  372.      tmp[tmpLen] := XDIRSEP;
  373.      INC(tmpLen);
  374.    END;
  375.  ELSIF pre = 1 THEN
  376.    (* duerfte nicht auftreten, ":..." *)
  377.    tmp[0] := XDIRSEP;
  378.    tmp[1] := EOS;
  379.    tmpLen := 1;
  380.    dIdx   := 1;
  381.  ELSE
  382.    dIdx := 0; (* nichts vom "DOS"-Pfad loeschen *)
  383.    IF pre > 2 THEN
  384.      tmp := "con:";
  385.      IF strcmp(CAST(StrPtr,ADR(tmp)), d) = 0 THEN
  386.        AssignM2ToC("/dev/tty", xSize, x);
  387.        xlen := 8;
  388.        RETURN;
  389.      ELSE
  390.        tmp       := "/dev/";
  391.        tmpLen    := 5;
  392.        d^[pre-1] := EOS; (* den Doppelpunkt loeschen *)
  393.        dLen      := pre - 1; (* fuer die Berechnung von 'xlen' korr. *)
  394.      END;
  395.    ELSE (* pre = 0 *)
  396.      tmp    := "";
  397.      tmpLen := 0;
  398.    END;
  399.  END; (* IF pre *)
  400.  
  401.  xlen := VAL(INTEGER,dLen - dIdx + tmpLen);
  402.  AssignM2ToC(tmp, xSize, x);
  403.  IF xSize > tmpLen THEN
  404.    (* Den restlichen (umgewandelten) Dospfad anhaengen *)
  405.    strncpy(CAST(StrPtr,ADDADR(x, tmpLen)),
  406.            CAST(StrPtr,ADDADR(d, dIdx)),
  407.            VAL(sizeT,xSize - tmpLen));
  408.  END;
  409. END DosToUnix;
  410.  
  411. (*---------------------------------------------------------------------------*)
  412.  
  413. PROCEDURE UnixToDos ((* EIN/ -- *) VAR xpath : ARRAY OF CHAR;
  414.                      (* EIN/ -- *)     xlen  : CARDINAL;
  415.                      (* EIN/ -- *)     dSize : StrRange;
  416.                      (* -- /AUS *)     dpath : StrPtr;
  417.                      (* -- /AUS *) VAR dot   : BOOLEAN;
  418.                      (* -- /AUS *) VAR done  : BOOLEAN       );
  419. (**)
  420. CONST TMPMAX = 13;
  421.  
  422. VAR __REG__ xIdx    : UNSIGNEDWORD;
  423.     __REG__ xLen    : UNSIGNEDWORD;
  424.     __REG__ dIdx    : UNSIGNEDWORD;
  425.     __REG__ c       : CHAR;
  426.     __REG__ d       : StrPtr;
  427.             xOffs   : UNSIGNEDWORD;
  428.             tmp     : ARRAY [0..TMPMAX] OF CHAR;
  429.             root    : BOOLEAN;
  430.             replace : BOOLEAN;
  431.             shift   : BOOLEAN;
  432.             stack   : ADDRESS;
  433.             bufP    : StrPtr;
  434.             res     : INTEGER;
  435.             buf     : ARRAY [0..1] OF CHAR;
  436.  
  437. BEGIN (* UnixToDos *)
  438.  d       := dpath;
  439.  xOffs   := 0;
  440.  done    := FALSE;
  441.  root    := FALSE;
  442.  replace := FALSE;
  443.  IF dSize = 0 THEN
  444.    e.errno := e.ENAMETOOLONG;
  445.    RETURN;
  446.  END;
  447.  xLen := VAL(UNSIGNEDWORD,xlen);
  448.  IF xLen = 0 THEN
  449.    e.errno := e.ENOENT;
  450.    RETURN;
  451.  END;
  452.  
  453.  ASSIGN(xpath, tmp);
  454.  FOR dIdx := 0 TO TMPMAX DO
  455.    IF tmp[dIdx] = DDIRSEP THEN
  456.      tmp[dIdx] := XDIRSEP;
  457.    END;
  458.  END;
  459.  
  460.  (* Da bei "GEMDOS" die Eintraege "." und ".." im Hauptverzeichnis nicht
  461.   * existieren, werden sie durch das Hauptverzeichnis ersetzt, falls mit
  462.   * Sicherheit festgestellt werden kann, dass das Hauptverzeichnis gemeint ist.
  463.   * Dies ist auch korrekt, wenn ein Dateisystem benutzt wird, dass diese
  464.   * Eintraege hat, da sie dann auch aufs Hauptverzeichnis verweisen.
  465.   *
  466.   * Es gibt folgende Faelle:
  467.   * - "/.", "/..", "/./xxx", "/../xxx" absoluter Pfad
  468.   *   hier kann sofort korrigiert werden.
  469.   *
  470.   * - ".", "..", "./xxx", "../xxx" relativer Pfad
  471.   *   hier muss zuerst festgestellt werden, ob das aktuelle Verzeichnis
  472.   *   das Hauptverzeichnis ist.
  473.   *
  474.   * - alle anderen Faelle (wenn "." oder ".." als Teil einer Pfadangabe
  475.   *   auftreten, auch wenn nur ein Laufwerk angegeben ist) werden hier
  476.   *   nicht korrigiert, da dies einen grossen Aufwand bedeutet, aber
  477.   *   seltener auftritt.
  478.   *)
  479.  
  480.  c := tmp[0];
  481.  IF c = '.' THEN
  482.    IF xLen > 1 THEN
  483.      c := tmp[1];
  484.    END;
  485.    IF (xLen = 1) OR (xLen = 2) AND (c = '.') THEN
  486.      replace := TRUE;
  487.    ELSIF (xLen > 1) AND ((c = XDIRSEP)
  488.                      OR (xLen > 2) AND (c = '.') AND (tmp[2] = XDIRSEP))
  489.    THEN
  490.      shift := TRUE;
  491.    END;
  492.    IF replace OR shift THEN
  493.      (* Testen, ob das aktuelle Verzeichnis das Wurzelverzeichnis ist *)
  494.      IF MiNT >= 96 THEN
  495.        root := Dgetcwd(ADR(buf), 0, 2, res) AND (buf[0] = 0C);
  496.        (* Wenn Dgetcwd nicht geklappt hat, war der Platz zu klein, d.h. das
  497.         * aktuelle Verzeichnis kann nicht das Wurzelverzeichnis sein.
  498.         *)
  499.      ELSE
  500.        memalloc(PATHMAX, stack, bufP);
  501.        (* Ohne MiNT kann man nur hoffen, dass PATHMAX ausreicht... *)
  502.        root := Dgetpath(bufP, 0, res) AND (bufP^[0] = 0C);
  503.        memdealloc(stack);
  504.      END;
  505.      IF root AND shift THEN
  506.        IF c = XDIRSEP THEN
  507.          (* "./xxx" --> "/xxx" *)
  508.          xOffs := 1;
  509.        ELSE (* tmp[2] = XDIRSEP *)
  510.          (* "../xxx" --> "/xxx" *)
  511.          xOffs := 2;
  512.        END;
  513.      ELSE
  514.        replace := FALSE;
  515.      END;
  516.    END;
  517.  ELSIF (xLen > 1) AND (c = XDIRSEP) AND (tmp[1] = '.') THEN
  518.    IF xLen > 2 THEN
  519.      c := tmp[2];
  520.    END;
  521.    IF (xLen = 2) OR (xLen = 3) AND (c = '.') THEN
  522.      replace := TRUE;
  523.    ELSIF (xLen > 2) AND ((c = XDIRSEP)
  524.                      OR (xLen > 3) AND (c = '.') AND (tmp[3] = XDIRSEP))
  525.    THEN
  526.      IF c = XDIRSEP THEN
  527.        (* "/./xxx" --> "/xxx" *)
  528.        xOffs := 2;
  529.      ELSE (* tmp[3] = XDIRSEP *)
  530.        (* "/../xxx" --> "/xxx" *)
  531.        xOffs := 3;
  532.      END;
  533.    END;
  534.  END;
  535.  IF replace THEN
  536.    (* ".", "..", "/.", "/.." --> "/" *)
  537.    xLen   := 1;
  538.    tmp[0] := XDIRSEP;
  539.    tmp[1] := EOS;
  540.  ELSIF xOffs > 0 THEN
  541.    DELETE(0, xOffs, tmp);
  542.    DEC(xLen, xOffs);
  543.  END;
  544.  
  545.  dot  := FALSE;
  546.  dIdx := 0;
  547.  xIdx := xOffs;
  548.  
  549.  IF EQUALN(5, XDEVPREFIX, tmp) THEN
  550.    (* xpath = /dev/... *)
  551.    IF (xLen > 5) AND isalpha(tmp[5]) AND ((xLen = 6) OR (tmp[6] = XDIRSEP)) THEN
  552.      (* "GEMDOS"-Laufwerksbezeichner: /dev/A, /dev/A/..., /dev/A\... --> A:
  553.       * <dpath>^ wird 4 Zeichen kuerzer als <xpath>.
  554.       *)
  555.      tmp[0] := tmp[5];
  556.      tmp[1] := DDRVPOSTFIX;
  557.      tmp[2] := EOS;
  558.      dIdx   := 2;
  559.      INC(xIdx, 6);
  560.    ELSIF MiNT > 0 THEN
  561.      INC(xIdx, 5);
  562.      (* Geraete sind bei MiNT ueber Laufwerk 'U' ansprechbar:
  563.       * /dev/... --> U:\dev\...
  564.       * <dpath>^ wird 2 Zeichen laenger als <xpath>.
  565.       *)
  566.      tmp  := "u:\dev\\"; (* \\ wegen Praeprozessor... *)
  567.      dIdx := 7;
  568.    ELSE
  569.      IF EQUAL("/dev/tty", tmp) THEN
  570.        (* <dpath>^ wird 4 Zeichen kuerzer als <xpath> *)
  571.        AssignM2ToC("con:", dSize, d);
  572.        done := dSize > 4; (* incl. Nullbyte *)
  573.      ELSE
  574.        (* <dpath>^ wird 4 Zeichen kuerzer als <xpath>, falls <xpath>
  575.         * nicht mit einem ':' abgechlossen ist, sonst 5 Zeichen.
  576.         *)
  577.        IF xpath[xOffs+xLen-1] <> DDRVPOSTFIX THEN
  578.          dIdx := 1; (* Flag: ":" anfuegen *)
  579.        END;
  580.        DEC(xLen, 5);
  581.        strncpy(d, CAST(StrPtr,ADR(xpath[xOffs+5])), VAL(sizeT,dSize)); (* /dev/ ueberspringen *)
  582.        done := xLen + dIdx < dSize;
  583.        IF done AND (dIdx = 1) THEN
  584.          d^[xLen]   := DDRVPOSTFIX;
  585.          d^[xLen+1] := 0C;
  586.        END;
  587.      END;
  588.      RETURN;
  589.    END;
  590.  ELSIF (MiNT > 0) AND EQUALN(6, "/pipe/", tmp) THEN
  591.    INC(xIdx, 6);
  592.    (* Pipes koennen ueber Laufwerk U: angesprochen werden:
  593.     * /pipe/... --> U:\pipe\...
  594.     * <dpath>^ wird 2 Zeichen laenger als <xpath>.
  595.     *)
  596.    tmp  := "u:\pipe\\";
  597.    dIdx := 8;
  598.  ELSIF (tmp[0] = XDIRSEP) AND NOT root AND (ROOTDIR <> 0C) THEN
  599.    (* <dpath>^ wird 2 Zeichen laenger als <xpath>. *)
  600.    tmp[0] := ROOTDIR;
  601.    tmp[1] := DDRVPOSTFIX;
  602.    tmp[2] := EOS;
  603.    dIdx   := 2;
  604.  END;
  605.  
  606.  INC(xLen, xOffs);
  607.  IF (xLen - xIdx) + dIdx >= dSize THEN
  608.    e.errno := e.ENAMETOOLONG;
  609.    RETURN;
  610.  END;
  611.  
  612.  AssignM2ToC(tmp, dIdx, d);
  613.  WHILE xIdx < xLen DO
  614.    c := xpath[xIdx];
  615.    IF c = XDIRSEP THEN (* / --> \ *)
  616.      c := DDIRSEP;
  617.    END;
  618.    d^[dIdx] := c;
  619.    INC(xIdx);
  620.    INC(dIdx);
  621.  END;
  622.  d^[dIdx] := 0C;
  623.  done     := TRUE;
  624.  
  625.  (* Die Zuweisung an CHAR-Variable steht hier nur, weil der nachfolgende
  626.   * Ausdruck moeglicherweise zu komplex fuer den einen oder anderen
  627.   * Compiler ist (-> TDI).
  628.   *)
  629.  IF dIdx > 1 THEN
  630.    c := d^[dIdx-2];
  631.  ELSE
  632.    c := 0C;
  633.  END;
  634.  dot :=     (dIdx > 0)
  635.         AND (d^[dIdx-1] = '.')
  636.              AND ((dIdx = 1)
  637.               OR  (c = DDIRSEP)
  638.               OR  (c = DDRVPOSTFIX)
  639.               OR  (c = '.')
  640.                    AND ((dIdx = 2)
  641.                     OR  (d^[dIdx-3] = DDIRSEP)
  642.                     OR  (d^[dIdx-3] = DDRVPOSTFIX)));
  643. END UnixToDos;
  644.  
  645. (*---------------------------------------------------------------------------*)
  646.  
  647. PROCEDURE FindFirst ((* EIN/ -- *)     path : StrPtr;
  648.                      (* EIN/ -- *)     attr : FileAttribute;
  649.                      (* EIN/AUS *) VAR dta  : DTA;
  650.                      (* -- /AUS *) VAR res  : INTEGER       ): BOOLEAN;
  651. (*T*)
  652. VAR olddta : ADDRESS;
  653.     done   : BOOLEAN;
  654.  
  655. BEGIN
  656.  olddta := Fgetdta();
  657.  Fsetdta(ADR(dta));
  658.  done := Fsfirst(path, attr, res);
  659.  Fsetdta(olddta);
  660.  RETURN(done);
  661. END FindFirst;
  662.  
  663. (*---------------------------------------------------------------------------*)
  664.  
  665. PROCEDURE FindNext ((* EIN/AUS *) VAR dta : DTA;
  666.                     (* -- /AUS *) VAR res : INTEGER ): BOOLEAN;
  667. (*T*)
  668. VAR olddta : ADDRESS;
  669.     done   : BOOLEAN;
  670.  
  671. BEGIN
  672.  olddta := Fgetdta();
  673.  Fsetdta(ADR(dta));
  674.  done := Fsnext(res);
  675.  Fsetdta(olddta);
  676.  RETURN(done);
  677. END FindNext;
  678.  
  679. (*---------------------------------------------------------------------------*)
  680.  
  681. PROCEDURE IsTerm ((* EIN/ -- *) h : INTEGER ): BOOLEAN;
  682. (*T*)
  683. VAR old  : SIGNEDLONG;
  684.     lres : SIGNEDLONG;
  685.     done : BOOLEAN;
  686.  
  687. BEGIN
  688.  done := Fseek(0, h, 1, old);
  689.  done := Fseek(1, h, 0, lres);
  690.  done := Fseek(old, h, 0, old);
  691.  
  692.  RETURN(lres = VAL(SIGNEDLONG,0));
  693. END IsTerm;
  694.  
  695. (*===========================================================================*)
  696.  
  697. VAR xmode : StrPtr;
  698.     i     : StrRange;
  699.     h     : SIGNEDWORD;
  700.     res   : INTEGER;
  701.     done  : BOOLEAN;
  702.     c     : CHAR;
  703.  
  704. BEGIN (* DosSupport *)
  705.  INODE   := 32 (* ?? *);
  706.  ROOTDIR := 0C;
  707.  BINIO   := FALSE;
  708.  xmode   := getenv("UNIXMODE");
  709.  IF xmode <> NULL THEN
  710.    i := 0;
  711.    c := xmode^[0];
  712.    WHILE c <> 0C DO
  713.      IF (c = 'r') AND (xmode^[i+1] <> 0C) THEN
  714.        ROOTDIR := tolower(xmode^[i+1]);
  715.        INC(i);
  716.      ELSIF (c = '.') AND (xmode^[i+1] <> 0C) THEN
  717.        INC(i);
  718.      ELSIF c = 'b' THEN
  719.        BINIO := TRUE;
  720.      END;
  721.      INC(i);
  722.      c := xmode^[i];
  723.    END;
  724.  END;
  725.  
  726.  IF (getenv("STDERR") = NULL) AND IsTerm(2) THEN
  727.    (* siehe Profibuch von 1992 *)
  728.    done := Fforce(2, -1, res);
  729.  END;
  730.  
  731.  MiNT := MiNTVersion();
  732.  IF (ROOTDIR = 0C) AND (MiNT > 0) THEN
  733.    IF Dgetdrv() = 20(*U*) THEN
  734.      ROOTDIR := 'u';
  735.    END;
  736.  END;
  737.  
  738.  FOR h := MinHandle TO MaxHandle DO
  739.    FD[h].ftype := unknown;
  740.  END;
  741. END DosSupport.
  742.